Collection of Internet/Collection of Internet.iso/infosrvr/doc/www_talk.arc/000345_marca@wintermu….ncsa.uiuc.edu _Thu Nov 19 04:29:11 1992.msg

Internet Message Format | 1992-11-30 | 24KB

Return-Path: <[e-mail]>
Received: from dxmint.cern.ch by  nxoc01.cern.ch  (NeXT-1.0 (From Sendmail 5.52)/NeXT-2.0)
    id AA12795; Thu, 19 Nov 92 04:29:11 MET
Received: by dxmint.cern.ch (dxcern) (5.57/3.14)
    id AA20231; Thu, 19 Nov 92 04:41:41 +0100
Received: from wintermute.ncsa.uiuc.edu by newton.ncsa.uiuc.edu with SMTP id AA11904
  (5.65a/IDA-1.4.2 for [e-mail]); Wed, 18 Nov 92 21:41:25 -0600
Received: by wintermute.ncsa.uiuc.edu (920110.SGI/911001.SGI)
    for @newton.ncsa.uiuc.edu:[e-mail] id AA09366; Wed, 18 Nov 92 21:42:37 -0800
Date: Wed, 18 Nov 92 21:42:37 -0800
From: [e-mail] (Marc Andreessen)
Message-Id: <[e-mail]>
To: [e-mail]
Subject: html-mode.el update

Following is the latest html-mode -- a few bugs have been fixed, and
some new features added.  If you use this, send me a note; if you have
ideas on how it could specifically be made to be smarter and more
helpful, let me know; if you don't think I should be mailing this to
everyone on www-talk, let me know that too (there was quite a bit of
initial interest in an html mode, so that's why I'm mailing it out
now).

Cheers,
Marc

--
Marc Andreessen
Software Development Group
National Center for Supercomputing Applications
[e-mail]

;;; --------------------------------------------------------------------------
;;; HTML mode, based on text mode.
;;; Copyright (C) 1985 Free Software Foundation, Inc.
;;; Copyright (C) 1992 National Center for Supercomputing Applications.
;;; NCSA modifications by Marc Andreessen ([e-mail]).
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation; either version 1, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING.  If not, write to the
;;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; -------------------------------- CONTENTS --------------------------------
;;;
;;; html-mode: Major mode for editing HTML hypertext documents.
;;; $Revision: 1.18 $
;;; $Date: 1992/11/19 05:39:25 $
;;;
;;; Canonical list of features:
;;;   See below.
;;;
;;; ------------------------------ INSTRUCTIONS ------------------------------
;;;
;;; Load html-mode.el before editing HTML documents.  html-mode will
;;; detect the ``.html'' suffix and activate itself appropriately.
;;;
;;; You are assumed to be at least somewhat familiar with HTML format.
;;; If you aren't, read about it first (see below).
;;;
;;; Here are key sequences and corresponding commands:
;;;
;;; NORMAL COMMANDS:
;;;
;;; C-c a         html-add-address
;;;   Open an address element.
;;;
;;; C-c d         html-add-definition-list
;;;   Open a definition list.  The initial entry is created for you.
;;;   To create subsequent entries, use 'C-c e'.
;;;
;;; C-c e         html-add-definition-entry
;;;   Add a new definition entry in a definition list.  You are
;;;   assumed to be inside a definition list (specifically, at the end
;;;   of another definition entry).
;;;
;;; C-c h         html-add-header
;;;   Add a header.  You are prompted for size (1 is biggest, 2 is
;;;   next biggest) and header contents.
;;;
;;; C-c i         html-add-list-or-menu-item
;;;   Add a new list or menu item in a list or menu.  You are assumed
;;;   to be inside a list or menu (specifically, at the end of another
;;;   item).
;;;
;;; C-c l         html-add-normal-link
;;;   Add a link.  You will be prompted for the link (any string;
;;;   e.g., http://foo.bar/argh/blagh).  The cursor will be left where
;;;   you can type the text that will represent the link in the
;;;   document.
;;;
;;; C-c m         html-add-menu
;;;   Open a menu.  The initial item is created for you.  To create
;;;   additional items, use 'C-c i'.
;;;
;;; C-c p         html-add-paragraph-separator
;;;   Use this command at the end of each paragraph.
;;;
;;; C-c s         html-add-list
;;;   Open a list.  The initial item is created for you.  To create
;;;   additional items, use 'C-c i'.
;;;
;;; C-c t         html-add-title
;;;   Add a title to the document.  You will be prompted for the
;;;   contents of the title.  If a title already exists at the very
;;;   top of the document, the existing contents will be replaced.
;;;
;;; C-c x         html-add-plaintext
;;;   Add plaintext.  The cursor will be positioned where you can type
;;;   plaintext (or insert another file, or whatever).
;;;
;;; COMMANDS THAT OPERATE ON THE CURRENT REGION:
;;;
;;; C-c C-r l     html-add-normal-link-to-region
;;;   Add a link that will be represented by the current region.  You
;;;   will be prompted for the link (any string, as with
;;;   html-add-normal-link).
;;;
;;; C-c C-r r     html-add-reference-to-region
;;;   Add a reference (a link that does not reference anything) that
;;;   will be represented by the current region.  You will be prompted
;;;   for the name of the link; if you just press RET, a numeric name
;;;   will be created for you.
;;;
;;; SPECIAL COMMANDS:
;;;
;;; <, >, &
;;;   These are overridden to output <, >, and &
;;;   respectively.  The real characters <, >, and & can be entered
;;;   into the text either by prepending 'C-c' to the character or by
;;;   using the Emacs quoted-insert (C-q) command.
;;;
;;; C-c <, C-c >, C-c &
;;;   See '< > &' above.
;;;
;;; NOTE: The key bindings above are what I find to be useful and easy
;;; to remember.  If you have ideas on how to make them easier to
;;; handle for yourself or other people, please let me know.
;;; (Ideally, these commands all go in menus; to that end, someday
;;; soon I'll add a Lucid Emacs menu to html-mode.)
;;;
;;; ---------------------------- ADDITIONAL NOTES ----------------------------
;;;
;;; If you are running Epoch or Lucid Emacs, highlighting will be used
;;; to deemphasize HTML message elements as they are created.  You can
;;; turn this off; see the source code.
;;;
;;; To reorder all of the link NAME fields in your message (in order
;;; of their occurrence in the text), use:
;;;
;;; html-reorder-numeric-names
;;;   Reorder the NAME fields for links in the current buffer.  The
;;;   new ordering starts at 1 and increases monotonically through the
;;;   buffer.  If optional arg REORDER-NON-NUMERIC is non-nil, then
;;;   non-numeric NAME's will also be numbered, else they won't.
;;;
;;; -------------------------------- GOTCHAS ---------------------------------
;;;
;;; HTML documents can be tricky.  html-mode is not smart enough to
;;; enforce correctness or sanity, so you have to do that yourself.
;;;
;;; In particular, html-mode is smart enough to generate unique
;;; numeric NAME id's for all links that were (1) created via an
;;; html-mode command or (2) present in the file when it was loaded.
;;; Any other links (e.g. links added via Emacs cut and paste) may
;;; have ID's that conflict with ID's html-mode generates.  You must
;;; watch for this and fix it when appropriate; otherwise, your
;;; hypertext document will not work correctly.
;;;
;;; html-reorder-numeric-names can be used to reset all of the NAME
;;; id's in a document to an ordered sequence; this will also give
;;; html-mode a chance to look over the document and figure out what
;;; new links should be named to be unique.
;;;
;;; ------------------------- WHAT HTML-MODE IS NOT --------------------------
;;;
;;; html-mode is not a mode for *browsing* HTML documents.  In
;;; particular, html-mode provides no hypertext capabilities.  There
;;; is a clear need for an HTML browser; if you write one, let me
;;; know.
;;;
;;; ------------------------------ WHAT HTML IS ------------------------------
;;;
;;; HTML (HyperText Markup Language) is a format for hypertext
;;; documents.  For more information on HTML, telnet to info.cern.ch.
;;;
;;; --------------------------------------------------------------------------
;;; LCD Archive Entry:
;;; html-mode|Marc Andreessen|[e-mail]|
;;; Major mode for editing HTML hypertext files.|
;;; $Date: 1992/11/19 05:39:25 $|$Revision: 1.18 $|~/modes/html-mode.el.Z|
;;; --------------------------------------------------------------------------

;; TODO:
;; sgml-mode stuff.

(provide 'html-mode)

;;; ------------------------------- variables --------------------------------

(defvar html-use-highlighting t
  "*Flag to use highlighting for HTML directives in Epoch or Lucid Emacs;
if non-NIL, highlighting will be used.")

(defvar html-deemphasize-color "grey80"
  "*Color for de-highlighting HTML directives in Epoch or Lucid Emacs.")

(defvar html-emphasize-color "yellow"
  "*Color for highlighting HTML something-or-others in Epoch or Lucid Emacs.")

;;; --------------------------------- setup ----------------------------------

(defvar html-mode-syntax-table nil
  "Syntax table used while in html mode.")

(defvar html-mode-abbrev-table nil
  "Abbrev table used while in html mode.")
(define-abbrev-table 'html-mode-abbrev-table ())

(if html-mode-syntax-table
    ()
  (setq html-mode-syntax-table (make-syntax-table))
  (modify-syntax-entry ?\" ".   " html-mode-syntax-table)
  (modify-syntax-entry ?\\ ".   " html-mode-syntax-table)
  (modify-syntax-entry ?' "w   " html-mode-syntax-table))

(defvar html-mode-map nil "")
(if html-mode-map
    ()
  (setq html-mode-map (make-sparse-keymap))
  (define-key html-mode-map "\t" 'tab-to-tab-stop)
  (define-key html-mode-map "\C-ca" 'html-add-address)
  (define-key html-mode-map "\C-cd" 'html-add-definition-list)
  (define-key html-mode-map "\C-ce" 'html-add-definition-entry)
  (define-key html-mode-map "\C-ch" 'html-add-header)
  (define-key html-mode-map "\C-ci" 'html-add-list-or-menu-item)
  (define-key html-mode-map "\C-cl" 'html-add-normal-link)
  (define-key html-mode-map "\C-cm" 'html-add-menu)
  (define-key html-mode-map "\C-cp" 'html-add-paragraph-separator)
  (define-key html-mode-map "\C-cs" 'html-add-list)
  (define-key html-mode-map "\C-ct" 'html-add-title)
  (define-key html-mode-map "\C-cx" 'html-add-plaintext)
  (define-key html-mode-map "<" 'html-less-than)
  (define-key html-mode-map ">" 'html-greater-than)
  (define-key html-mode-map "&" 'html-ampersand)
  (define-key html-mode-map "\C-c<" 'html-real-less-than)
  (define-key html-mode-map "\C-c>" 'html-real-greater-than)
  (define-key html-mode-map "\C-c&" 'html-real-ampersand)
  (define-key html-mode-map "\C-c\C-rl" 'html-add-normal-link-to-region)
  (define-key html-mode-map "\C-c\C-rr" 'html-add-reference-to-region)
)

;;; --------------------------- buffer-local vars ----------------------------

(defvar html-link-counter-default 0)
(defvar html-link-counter nil)
(make-variable-buffer-local 'html-link-counter)
(setq-default html-link-counter html-link-counter-default)

;;; ------------------------------ highlighting ------------------------------

(defvar html-running-lemacs (string-match "Lucid" emacs-version)
  "Non-nil if running Lucid Emacs.")

(defvar html-running-epoch (boundp 'epoch::version)
  "Non-nil if running Epoch.")

(if (and html-running-epoch html-use-highlighting)
    (progn
      (defvar html-deemphasize-style (make-style))
      (set-style-foreground html-deemphasize-style html-deemphasize-color)
      (defvar html-emphasize-style (make-style))
      (set-style-foreground html-emphasize-style html-emphasize-color)))

(if (and html-running-lemacs html-use-highlighting)
    (progn
      (defvar html-deemphasize-style (make-face 'html-deemphasize-face))
      (set-face-foreground html-deemphasize-style html-deemphasize-color)
      (defvar html-emphasize-style (make-face 'html-emphasize-face))
      (set-face-foreground html-emphasize-style html-emphasize-color)))

(if html-use-highlighting
    (progn
      (if html-running-lemacs
          (defun html-add-zone (start end style)
            "Add a Lucid Emacs extent from START to END with STYLE."
            (let ((extent (make-extent start end)))
              (set-extent-face extent style)
              (set-extent-data extent 'html-mode))))
      (if html-running-epoch
          (defun html-add-zone (start end style)
            "Add an Epoch zone from START to END with STYLE."
            (let ((zone (add-zone start end style)))
              (epoch::set-zone-data zone 'html-mode))))))

(defun html-maybe-deemphasize-region (start end)
  "Maybe deemphasize a region of text.  Region is from START to END."
  (and (or html-running-epoch html-running-lemacs)
       html-use-highlighting
       (html-add-zone start end html-deemphasize-style)))

;;; ----------------------------- link commands ------------------------------

(defun html-add-link (link-object)
  "Add a link."
  (let ((start (point)))
    (setq html-link-counter (1+ html-link-counter))
    (insert "<A NAME=" (format "%d" html-link-counter)
            " HREF=" link-object ">")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert "</A>")
    (push-mark)
    (forward-char -4)
    (html-maybe-deemphasize-region (1+ (point)) (+ (point) 4))))

(defun html-add-normal-link (link)
  "Make a link.  There is no completion of any kind yet."
  (interactive "sLink to: ")
  (html-add-link link))

(defun html-add-normal-link-to-region (link start end)
  "Make a link that applies to the current region.  Again,
no completion."
  (interactive "sLink to: \nr")
  (save-excursion
    (goto-char end)
    (save-excursion
      (goto-char start)
      (setq html-link-counter (1+ html-link-counter))
      (insert "<A NAME=" (format "%d" html-link-counter)
              " HREF=" link ">")
      (html-maybe-deemphasize-region start (1- (point))))
    (insert "</A>")
    (html-maybe-deemphasize-region (- (point) 3) (point))))

(defun html-add-reference-to-region (name start end)
  "Add a reference point (a link with no reference of its own) to
the current region."
  (interactive "sName (or RET for numeric): \nr")
  (and (string= name "")
       (progn
         (setq html-link-counter (1+ html-link-counter))
         (setq name (format "%d" html-link-counter))))
  (save-excursion
    (goto-char end)
    (save-excursion
      (goto-char start)
      (insert "<A NAME=" name ">")
      (html-maybe-deemphasize-region start (1- (point))))
    (insert "</A>")
    (html-maybe-deemphasize-region (- (point) 3) (point))))

;;; --------------------------- document elements ----------------------------

(defun html-add-title (title)
  "Add or modify a title."
  (interactive "sTitle: ")
  (save-excursion
    (goto-char (point-min))
    (if (and (looking-at "<TITLE>")
             (save-excursion
               (forward-char 7)
               (re-search-forward "[^<]*"
                                  (save-excursion (end-of-line) (point))
                                  t)))
        ;; Plop the new title in its place.
        (replace-match title t)
      (insert "<TITLE>")
      (html-maybe-deemphasize-region (point-min) (1- (point)))
      (insert title)
      (insert "</TITLE>")
      (html-maybe-deemphasize-region (- (point) 7) (point))
      (insert "\n"))))

(defun html-add-header (size header)
  "Add a header."
  (interactive "sSize (1 or 2): \nsHeader: ")
  (let ((start (point)))
    (insert "<H" size ">")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert header)
    (setq start (point))
    (insert "</H" size ">\n")
    (html-maybe-deemphasize-region (1+ start) (1- (point)))))

(defun html-add-paragraph-separator ()
  "Add a paragraph separator."
  (interactive)
  (let ((start (point)))
    (insert "  <P>\n\n")
    (html-maybe-deemphasize-region (+ start 2) (- (point) 2))))

(defun html-add-definition-list ()
  "Add a definition list."
  (interactive)
  (let ((start (point)))
    (insert "<DL>\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert "<DT> ")
    ;; Point goes right there.
    (save-excursion
      (insert "\n<DD> \n")
      (setq start (point))
      (insert "</DL>\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; Mark goes after list -- this doesn't work.
      (push-mark))))

(defun html-add-definition-entry ()
  "Add a definition entry.  Assume we're at the end of a previous
entry."
  (interactive)
  (let ((start (point)))
    (insert "\n<DT> ")
    (save-excursion
      (insert "\n<DD> "))))

(defun html-add-plaintext ()
  "Add plaintext."
  (interactive)
  (let ((start (point)))
    (insert "<XMP>\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (save-excursion
      (insert "\n")
      (setq start (point))
      (insert "</XMP>\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; This doesn't work.
      (push-mark))))

(defun html-add-list-internal (type)
  (let ((start (point)))
    (insert "<" type ">\n")
    (html-maybe-deemphasize-region start (1- (point)))
    (insert "<LI> ")
    ;; Point goes right there.
    (save-excursion
      (insert "\n")
      (setq start (point))
      (insert "</" type ">\n")
      (html-maybe-deemphasize-region start (1- (point)))
      ;; Mark goes after list -- this doesn't work.
      (push-mark))))

(defun html-add-list ()
  "Add a list."
  (interactive)
  (html-add-list-internal "UL"))

;; Is this correct?  Viola doesn't seem to do anything with it.
(defun html-add-menu ()
  "Add a menu."
  (interactive)
  (html-add-list-internal "MENU"))

(defun html-add-list-or-menu-item ()
  "Add a list or menu item.  Assume we're at the end of the
last item."
  (interactive)
  (let ((start (point)))
    (insert "\n<LI> ")))

(defun html-add-address ()
  "Add an address."
  (interactive)
  (let ((start (point)))
    (insert "<ADDRESS> ")
    (html-maybe-deemphasize-region start (1- (point)))
    (save-excursion
      (setq start (point))
      (insert "  </ADDRESS>\n")
      (html-maybe-deemphasize-region (+ start 2) (1- (point)))
      ;; Obviously this doesn't work here, so I don't
      ;; see why you're being an idiot and still doing it
      ;; like this....
      (push-mark))))

(defun html-less-than ()
  (interactive)
  (insert "<"))

(defun html-greater-than ()
  (interactive)
  (insert ">"))

(defun html-ampersand ()
  (interactive)
  (insert "&"))

(defun html-real-less-than ()
  (interactive)
  (insert "<"))

(defun html-real-greater-than ()
  (interactive)
  (insert ">"))

(defun html-real-ampersand ()
  (interactive)
  (insert "&"))

;;; ----------------------- html-reorder-numeric-names -----------------------

(defun replace-string-in-buffer (start end newstring)
  (save-excursion
    (goto-char start)
    (delete-char (1+ (- end start)))
    (insert newstring)))

(defun html-reorder-numeric-names (&optional reorder-non-numeric)
  "Reorder the NAME fields for links in the current buffer.  The
new ordering starts at 1 and increases monotonically through the buffer.
If optional arg REORDER-NON-NUMERIC is non-nil, then non-numeric NAME's
will also be numbered, else they won't.

Beware that doing this will possibly mess up references to specific
links within this document (e.g., HREF=#12) or by other documents.
This command is mainly intended for use during the initial creation
stage of a document, especially when this creation involves cutting
and pasting from other documents (which it shouldn't, since this is
hypertext :-)."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (setq html-link-counter 0)
    (while (re-search-forward "<A[ \t\n]+NAME=" (point-max) t)
      (let* ((start (match-end 0))
             (end (save-excursion
                    (re-search-forward "[ \t\n>]"
                                       (point-max)
                                       t)
                    (match-beginning 0)))
             (subst (buffer-substring start end)))
        (and subst
             ;; Proceed only if we reorder non-numeric links or
             ;; this is in fact numeric (i.e. > 0).
             (or reorder-non-numeric (> (string-to-int subst) 0))
             (progn
               (setq html-link-counter (1+ html-link-counter))
               (replace-string-in-buffer start (1- end)
                (format "%d" html-link-counter))))))))

;;; ------------------------------- html-mode --------------------------------

(defun html-mode ()
  "Major mode for editing HTML hypertext documents.  Special commands:\\{html-mode-map}
Turning on html-mode calls the value of the variable html-mode-hook,
if that value is non-nil.

More extensive documentation is available in the file 'html-mode.el'.
The latest (possibly unstable) version of this file will always be available
on anonymous FTP server ftp.ncsa.uiuc.edu in /outgoing/marca."
  (interactive)
  (kill-all-local-variables)
  (use-local-map html-mode-map)
  (setq mode-name "Html")
  (setq major-mode 'html-mode)
  (setq local-abbrev-table html-mode-abbrev-table)
  (set-syntax-table html-mode-syntax-table)
  (run-hooks 'html-mode-hook))

;;; ------------------------------- our hooks --------------------------------

(defun html-find-file-hook ()
  "Hook called from find-file-hooks.  Set html-link-counter to
the highest link value in the document (the next link created will
be one greater than that) to insure unique (numeric) link ID's."
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "<A[ \t\n]+NAME=" (point-max) t)
      (let* ((start (match-end 0))
             (end (save-excursion
                    (re-search-forward "[ \t\n>]"
                                       (point-max)
                                       t)
                    (match-beginning 0)))
             (subst (buffer-substring start end)))
        (and subst
             ;; Safe to do compare, since string-to-int passed a non-number
             ;; returns 0.
             (> (string-to-int subst) html-link-counter)
             (setq html-link-counter (string-to-int subst)))))))

;;; ------------------------------- hook setup -------------------------------

;; Author: Daniel LaLiberte ([e-mail]).
(defun html-postpend-unique-hook (hook-var hook-function)
  "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
hook-var's value may be a single function or a list of functions."
  (if (boundp hook-var)
      (let ((value (symbol-value hook-var)))
        (if (and (listp value) (not (eq (car value) 'lambda)))
            (and (not (memq hook-function value))
                 (set hook-var (append value (list hook-function))))
          (and (not (eq hook-function value))
               (set hook-var (append value (list hook-function))))))
    (set hook-var (list hook-function))))

(html-postpend-unique-hook 'find-file-hooks 'html-find-file-hook)

;;; ------------------------------ final setup -------------------------------

(or (assoc "\\.html$" auto-mode-alist)
    (setq auto-mode-alist (cons '("\\.html$" . html-mode) auto-mode-alist)))